home *** CD-ROM | disk | FTP | other *** search
/ Shareware Extravaganza - Disc 4 / Shareware Extravaganza - Over 25,000 Programs (The Ultimate Shareware Company)(Disc 4 of 4)(1993).iso / cad / jul90.zip / CLINE.LSP < prev    next >
Lisp/Scheme  |  1990-07-09  |  3KB  |  65 lines
  1. ; ***************************CLINE.LSP*************************
  2. ; Custom Linetype Program
  3. ; Copyright (c) Barry R. Bowen 1990
  4. ; -------------------------------------------------------------
  5. ; TOOLBOX Routines Used
  6. ; (LS)                            Create new layer (Feb '90)
  7. ; (RL)                       Re-set existing layer (Feb '90)
  8. ; (V1)   Saves original values of system variables (Feb '89)
  9. ; (V1R)   Restores original system variable values (Feb '89)
  10. ; (V3)                            Start-up routine (Feb '89)
  11. ; (V4)                              Ending routine (Feb '89)
  12. ; -------------------------------------------------------------
  13. ; Variables:
  14. ; ANG   = Angle between PT1 & PT2
  15. ; BLK   = Block name to insert for the linetype
  16. ; COL   = Number of columns for the array
  17. ; DIST  = Distance between PT1 & PT2 or line length
  18. ; LN1   = Attribute for Size
  19. ; LN2   = Attribute for Material
  20. ; MDIST = Array distance for the block BLK
  21. ; PT1   = Line start point
  22. ; PT2   = Line end point
  23. ; RE    = Remainder of the Distance divided by the unit
  24.           length
  25. ; SU    = Current snap unit setting
  26. ; UNL   = Block unit length
  27. ; WDTH  = Block width
  28. ; WN    = Distance converted to an integer
  29. ; X     = X scale factor
  30. ;
  31. ; SAMPLE CALL: (CLINE BLK WDTH UNL LN1 LN2)
  32. ;              (CLINE "PLYWD" 0.25 1 "1/4 PLYWOOD" "")
  33. ; -------------------------------------------------------------
  34. (defun CLINE (BLK WDTH UNL LN1 LN2 / ANG COL DIST MDIST     ; 1
  35.                                      RE SU WN X)            ; 2
  36.   (V3)                        ;Start-up                     ; 3
  37.   (V1 '("osmode" "snapmode" "attreq" "attdia" "orthomode")) ; 4
  38.   (LS "DETAIL" "7" "")        ;Layer/color/linetype         ; 5
  39.   (setvar "attreq" 1)         ;Attribute prompt on          ; 6
  40.   (setvar "attdia" 0)         ;Attribute dialogue box off   ; 7
  41.   (command "osnap" "none")    ;Snapmode none                ; 8
  42.   (setvar "orthomode" 1)      ;Ortho on                     ; 9
  43.   (setq SU (getvar "snapunit"))                             ;10
  44.   (command "snap" "0.0625")   ;Set snap to 1/16"            ;11
  45.   (initget 1)                 ;Disallow null input          ;12
  46.   (setq PT1 (getpoint "\nFirst Point: "))                   ;13
  47.   (initget 32)                ;Use dashed rubberband        ;14
  48.   (setq PT2 (getpoint PT1 "\nSecond Point: ")               ;15
  49.        DIST (distance PT1 PT2)                              ;16
  50.         ANG (angtos (angle PT1 PT2) 1 4)                    ;17
  51.          RE (rem DIST UNL)    ;Remainder                    ;18
  52.          WN (fix DIST)        ;Convert to an integer        ;19
  53.          RE (/ RE WN)         ;Used for X-scale factor      ;20
  54.         COL (/ WN UNL)        ;Number of columns            ;21
  55.           X (1+ RE)           ;X-scale factor               ;22
  56.       MDIST (* UNL X)         ;Array distance               ;23
  57.   )                           ;End SetQ                     ;24
  58.   (command 
  59.     "minsert" BLK PT1 X WDTH ANG "1" COL MDIST LN1 LN2)     ;25
  60.   (setvar "snapunit" SU)      ;Re-set original snap         ;26
  61.   (V1R)                       ;Restore original variables   ;27
  62.   (RL)                        ;Restore original layer       ;28
  63.   (V4)                        ;Ending routine               ;29
  64. )                             ;End DeFun                    ;30
  65.